home *** CD-ROM | disk | FTP | other *** search
/ ETO Development Tools 1 / ETO Development Tools 1.iso / Tools - Objects / MacApp / MacApp 2.0 CD Release / MacApp 2.0 (Many Libraries) / Libraries / UMacApp.Globals.p < prev    next >
Encoding:
Text File  |  1990-03-27  |  43.5 KB  |  1,767 lines  |  [TEXT/MPS ]

  1. {$P}
  2. {[a-,body+,h-,o=100,r+,rec+,t=4,u+,#+,j=20/57/1$,n-]}
  3. { UMacApp.Globals.p }
  4. { Copyright © 1984-1990 by Apple Computer Inc. All rights reserved. }
  5.  
  6. PROCEDURE InitializationThatMustNotFail;
  7.     FORWARD;
  8.  
  9. PROCEDURE DoInitUMacApp;
  10.     FORWARD;
  11.  
  12. {--------------------------------------------------------------------------------------------------}
  13. {$S MAGlobalsRes}
  14.  
  15. PROCEDURE ApplicationBeep;
  16.  
  17.     BEGIN
  18.     IF gApplication <> NIL THEN
  19.         gApplication.Beep(2)
  20.     ELSE
  21.         SysBeep(2);
  22.     END;
  23.  
  24. {--------------------------------------------------------------------------------------------------}
  25. {$S MAGlobalsRes}
  26.  
  27. PROCEDURE CanPaste(aClipType: ResType);
  28.  
  29.     BEGIN
  30.     IF gClipView <> NIL THEN
  31.         IF gClipView.ContainsClipType(aClipType) THEN
  32.             BEGIN
  33.             gGotClipType := TRUE;
  34.             gPrefClipType := aClipType;
  35.             END;
  36.     END;
  37.  
  38. {--------------------------------------------------------------------------------------------------}
  39. {$S MAGlobalsRes}
  40. {$Push} {$IFC qTrace} {$D+} {$EndC}
  41.  
  42. PROCEDURE CleanupMacApp;
  43.  
  44.     VAR
  45.         OldA5:                LongInt;
  46.  
  47.     BEGIN
  48.     OldA5 := SetCurrentA5;                                { ***** Called from trap patches *****}
  49.  
  50.     { Make sure segments can load }
  51.     SetResLoad(TRUE);
  52.     IF PermAllocation(FALSE) THEN;
  53.  
  54.     UnpatchTrap(pETSPatch);                             { Guaranteed not to fail }
  55.  
  56.     IF gApplication <> NIL THEN
  57.         gApplication.Terminate;
  58.  
  59.     BusyRemove;
  60.  
  61.     {$IFC qDebug}
  62.     DebugTerminate;
  63.     {$ENDC}
  64.  
  65.     UnpatchAll;
  66.  
  67.     IF SetChooserAlert(gOldChooserFlag) THEN;
  68.  
  69.     OldA5 := SetA5(OldA5);
  70.     END;
  71. {$Pop}
  72.  
  73. {--------------------------------------------------------------------------------------------------}
  74. {$S MAGlobalsRes}
  75.  
  76. PROCEDURE DoneViewRsrc(viewRsrc: UNIV Handle;
  77.                        lastPtr: UNIV LongInt);
  78.  
  79.     BEGIN
  80.     HUnlock(viewRsrc);
  81.     SetPermHandleSize(viewRsrc, StripLong(lastPtr) - StripLong(viewRsrc^));
  82.     END;
  83.  
  84. {--------------------------------------------------------------------------------------------------}
  85. {$IFC qDebug}
  86. {$S MADebug}
  87. {$Push} {$IFC qTrace} {$D+} {$ENDC}
  88.  
  89. PROCEDURE DoneWithTempRgn;
  90.  { Indicates that gTempRgn is no longer in use. Call this only if qDebug
  91.   is true. }
  92.  
  93.     BEGIN
  94.     IF NOT gBusyTempRgn THEN
  95.         ProgramBreak('DoneWithTempRgn called, but gTempRgn is not locked');
  96.     gBusyTempRgn := FALSE;
  97.     gUsedBy := '';
  98.     SetEmptyRgn(gTempRgn);
  99.     END;
  100. {$Pop}
  101. {$ENDC}
  102.  
  103. {--------------------------------------------------------------------------------------------------}
  104. {$IFC qDebug}
  105. {$S MADebug}
  106.  
  107. PROCEDURE EntDebugger(entering: BOOLEAN);
  108.  
  109.     BEGIN
  110.     BusyActivate(NOT entering);
  111.     END;
  112. {$ENDC}
  113.  
  114. {--------------------------------------------------------------------------------------------------}
  115. {$S MAError}
  116.  
  117. PROCEDURE ErrorAlert(err: OSErr;
  118.                      message: LongInt);
  119.  
  120.     CONST
  121.         kMsgCmdErr            = msgCmdErr DIV $10000;
  122.         kMsgAlert            = msgAlert DIV $10000;
  123.         kMsgLookup            = msgLookup DIV $10000;
  124.         kMsgAltRecov        = msgAltRecovery DIV $10000;
  125.  
  126.     TYPE
  127.         Converter            = RECORD
  128.             CASE BOOLEAN OF
  129.                 TRUE:
  130.                     (message:             LongInt);
  131.                 FALSE:
  132.                     (hiWd, loWd:         INTEGER);
  133.             END;
  134.  
  135.     VAR
  136.         c:                    Converter;
  137.         alertID:            INTEGER;
  138.         genericAlert:        BOOLEAN;
  139.         opString:            Str255;
  140.         errStr:             Str255;
  141.         recovErr:            OSErr;
  142.         recovery:            Str255;
  143.         x:                    BOOLEAN;
  144.  
  145.     BEGIN
  146.     c.message := message;
  147.  
  148.     alertID := phGenError;                                { the default alert }
  149.     genericAlert := TRUE;
  150.     opString := '';
  151.  
  152.     CASE c.hiWd OF
  153.         kMsgCmdErr:
  154.             BEGIN
  155.             alertID := phCmdErr;
  156.             CmdToName(c.loWd, opString);
  157.             END;
  158.         kMsgAlert:
  159.             BEGIN
  160.             alertID := c.loWd;
  161.             genericAlert := FALSE;
  162.             END;
  163.         kMsgLookup, kMsgAltRecov:
  164.             BEGIN
  165.             x := LookupErrString(c.loWd, errOperationsID, opString);
  166.             END;
  167.         OTHERWISE
  168.             BEGIN
  169.             GetIndString(opString, c.hiWd, c.loWd);
  170.             END;
  171.     END;
  172.  
  173.     IF genericAlert THEN
  174.         BEGIN
  175.         x := LookupErrString(err, errReasonID, errStr);
  176.  
  177.         IF c.hiWd = kMsgAltRecov THEN
  178.             recovErr := c.loWd
  179.         ELSE
  180.             recovErr := err;
  181.  
  182.         x := LookupErrString(recovErr, errRecoveryID, recovery);
  183.  
  184.         ParamText(errStr, recovery, opString, gErrorParm3);
  185.  
  186.         IF opString = '' THEN
  187.             alertID := phUnknownErr;
  188.         END;
  189.  
  190.     StdAlert(alertID);
  191.     gInhibitNestedHandling := FALSE;                    { Used suppress nested event handling }
  192.  
  193.     IF genericAlert THEN
  194.         ResetAlrtStage;
  195.     END;
  196.  
  197. {--------------------------------------------------------------------------------------------------}
  198. {$S MATerminate}
  199.  
  200. PROCEDURE ExitMacApp;
  201.  
  202.     BEGIN
  203.     CleanupMacApp;
  204.     ExitToShell;
  205.     END;
  206.  
  207. {--------------------------------------------------------------------------------------------------}
  208. {$S MAGlobalsRes}
  209.  
  210. FUNCTION ExpandPtr(viewRsrc: UNIV Handle;
  211.                    VAR p: UNIV LongInt;
  212.                    offset: LongInt): Ptr;
  213.  
  214.     VAR
  215.         oldOffset:            LongInt;
  216.         rsrcSize:            Size;
  217.         desiredEnd:         LongInt;
  218.         rsrcBase:            LongInt;
  219.         currentPtr:         LongInt;
  220.  
  221.     BEGIN
  222.     rsrcSize := GetHandleSize(viewRsrc);
  223.     rsrcBase := StripLong(viewRsrc^);
  224.     currentPtr := StripLong(p);
  225.     IF ODD(offset) THEN
  226.         offset := offset + 1;
  227.     desiredEnd := currentPtr + offset + SIZEOF(INTEGER);
  228.  
  229.     IF desiredEnd >= rsrcBase + rsrcSize THEN
  230.         BEGIN
  231.   { This appropriation logic might need some re-examination.  If the size of the added
  232.    template is larger than the minimum amount, then simply the size is added.  If
  233.    the handle is already near to being full, this won't help for the next allocation.
  234.    Maybe it should use a hystersis?… }
  235.         oldOffset := currentPtr - rsrcBase;
  236.         HUnlock(viewRsrc);
  237.         SetHandleSize(viewRsrc, rsrcSize + MAX(kViewRsrcExpandAmt, offset));
  238.         FailMemError;
  239.         LockHandleHigh(viewRsrc);
  240.         p := LongInt(viewRsrc^) + oldOffset;
  241.         END;
  242.     ExpandPtr := Ptr(p);
  243.     OffsetPtr(p, offset);
  244.     END;
  245.  
  246. {--------------------------------------------------------------------------------------------------}
  247. {$S MAGlobalsRes}
  248.  
  249. FUNCTION ExpandPtrWStr(viewRsrc: UNIV Handle;
  250.                        VAR p: UNIV LongInt;
  251.                        offset, len: LongInt): Ptr;
  252.  
  253.     BEGIN
  254.     ExpandPtrWStr := ExpandPtr(viewRsrc, p, offset - 255 + len);
  255.     END;
  256.  
  257. {--------------------------------------------------------------------------------------------------}
  258. {$S MAFinder}
  259. { This is a dummy procedure to allow us to find the Finder segment }
  260.  
  261. PROCEDURE FinderSegProc;
  262.  
  263.     BEGIN
  264.     END;
  265.  
  266. {--------------------------------------------------------------------------------------------------}
  267. {$S MAGlobalsRes}
  268.  
  269. FUNCTION FreeIfWMgrWindow(w: WindowPtr;
  270.                          dispose: BOOLEAN): WindowPtr;
  271.  
  272.     BEGIN
  273.     FreeIfWMgrWindow := NIL;    { convenience to caller }
  274.  
  275.     IF w <> NIL THEN
  276.         BEGIN
  277.         IF dispose THEN
  278.             BEGIN
  279.             IF w = thePort THEN                         { Only need to invalidate focus if freed
  280.                                                          window is the current port }
  281.                 BEGIN
  282.                 IF gApplication <> NIL THEN
  283.                     gApplication.InvalidateFocus;
  284.                 SetPort(gWorkPort);
  285.                 END;
  286.             DisposeWindow(w);
  287.             END
  288.         ELSE
  289.             CloseWindow(w);
  290.         END;
  291.     END;
  292.  
  293. {--------------------------------------------------------------------------------------------------}
  294. {$S MAGlobalsRes}
  295.  
  296. PROCEDURE FreeWMgrWindow(w: WindowPtr;
  297.                          dispose: BOOLEAN);
  298.  
  299.     BEGIN
  300.     w := FreeIfWMgrWindow(w, dispose);
  301.     END;
  302.  
  303. {--------------------------------------------------------------------------------------------------}
  304. {$S MAGlobalsRes}
  305.  
  306. PROCEDURE GetFocus(VAR theFocusRec: FocusRec);
  307.  
  308.     BEGIN
  309.     WITH theFocusRec DO
  310.         BEGIN
  311.         GetPort(Port);
  312.         GetClip(Clip);
  313.         Org := Port^.portRect.topLeft;
  314.         LongOffset := gLongOffset;
  315.         FocusedView := gFocusedView;
  316.         printing := gPrinting;
  317.         drawingPictScrap := gDrawingPictScrap;
  318.         drawingPictScrapView := gDrawingPictScrapView;
  319.         isValid := TRUE;
  320.         END;
  321.     END;
  322.  
  323. {--------------------------------------------------------------------------------------------------}
  324. {$S MAGlobalsRes}
  325.  
  326. FUNCTION GetNewCenteredDialog(dialogID: INTEGER;
  327.                               dStorage: Ptr;
  328.                               behind: WindowPtr): DialogPtr;
  329.  
  330.     VAR
  331.         dlogTemplate:        DialogTHndl;
  332.  
  333.     BEGIN
  334.     GetNewCenteredDialog := NIL;
  335.     SetCursor(arrow);
  336.     IF gApplication <> NIL THEN
  337.         gApplication.InvalidateCursorRgn;
  338.     dlogTemplate := DialogTHndl(GetResource('DLOG', dialogID));
  339.     IF dlogTemplate <> NIL THEN
  340.         BEGIN
  341.         CenterRectOnScreen(dlogTemplate^^.boundsRect, TRUE, TRUE, TRUE);
  342.         GetNewCenteredDialog := GetNewDialog(dialogID, dStorage, behind);
  343.         END
  344.     ELSE
  345.         BEGIN
  346.         SysBeep(2);                                     { At least give some indication }
  347.         {$IFC qDebug}
  348.         ProgramBreak(ConcatNumber('Unable to find ‘DLOG’ resource ', dialogID));
  349.         {$ENDC}
  350.         END;
  351.     END;
  352.  
  353. {--------------------------------------------------------------------------------------------------}
  354. {$S MAUtilitiesRes}{ Really a utility but, the gWorkPort isn't reachable from UMacAppUtilities }
  355.  
  356. PROCEDURE GetTextStyleFontInfo(theTextStyle: TextStyle; VAR theFontInfo: FontInfo);
  357.  
  358.     VAR
  359.         savedPort:    GrafPtr;
  360.  
  361.     BEGIN
  362.     GetPort(savedPort);
  363.     SetPort(gWorkPort);
  364.     SetPortTextStyle(theTextStyle);
  365.     GetFontInfo(theFontInfo);
  366.     SetPort(savedPort);
  367.     END;
  368.  
  369. {--------------------------------------------------------------------------------------------------}
  370. {$S MAGlobalsRes}                                        { Must be in a resident segment so that
  371.                                                          UnloadAllSegments doesn't unload it. }
  372.  
  373. PROCEDURE HdlInitFailed(error: OSErr;
  374.                         message: LongInt);
  375.  
  376.     BEGIN
  377.     UnloadAllSegments;
  378.  
  379.     IF error <> noErr THEN                                { check to see if an alert has already been
  380.                                                          displayed }
  381.         BEGIN
  382.         IF message = 0 THEN
  383.             message := msgInitFailed;                    { if no message specified, use our own }
  384.  
  385.         ErrorAlert(error, message);
  386.  
  387.         ExitToShell;
  388.         END;
  389.     END;
  390.  
  391. {--------------------------------------------------------------------------------------------------}
  392. {$Push}
  393. {$MC68020-}                                             { Must be universal code }
  394. {$S Main}
  395. { Essential one-time initialization }
  396.  
  397. PROCEDURE InitUMacApp(callsToMoreMasters: INTEGER);
  398. { Must be in the Main segment since all other segments get unloaded from here.}
  399.  
  400.     VAR
  401.         initSeg:            INTEGER;
  402.         applZone:            THz;
  403.         oldMoreMast:        INTEGER;
  404.  
  405.     PROCEDURE HdlInitUMacApp(error: OSErr;
  406.                              message: LongInt);
  407.  
  408.         BEGIN
  409.         { try to make a little extra room. }
  410.         UnloadSeg(@InitializationThatMustNotFail);
  411.  
  412.         IF error <> noErr THEN                            { check to see if an alert has already been
  413.                                                          displayed }
  414.             BEGIN
  415.             IF message = 0 THEN
  416.                 message := msgInitFailed;                { if no message specified, use our own }
  417.  
  418.             {$IFC qDebug}
  419.             UnloadSeg(@PLFlush);
  420.             {$ENDC}
  421.  
  422.             ErrorAlert(error, message);
  423.  
  424.             ExitToShell;
  425.             END;
  426.         END;
  427.  
  428.     BEGIN
  429.     IF NOT gToolboxInitialized THEN
  430.         InitToolbox;
  431.  
  432.     IF ValidateConfiguration(gConfiguration) THEN        { Make sure we can run. The programmer really
  433.                                                         should have ensured this in their "M" file but
  434.                                                         this is a backup check just in case.  After
  435.                                                         all 68000's don't really like to RTD.}
  436.         BEGIN
  437.         InitializationThatMustNotFail;
  438.     
  439.         CatchFailures(pFi, HdlInitUMacApp);
  440.         InitUMemory;
  441.     
  442.         { Install Outermost failure handler }
  443.         Success(pFi);
  444.         CatchFailures(pFi, HdlInitFailed);
  445.     
  446.         UnloadAllSegments;
  447.     
  448.         { Here is a trick sugested by Jerome C.--it allocates one large block of master pointers
  449.         ??? Its cute, but will it eventually break? }
  450.         applZone := ApplicZone;
  451.         oldMoreMast := applZone^.moreMast;
  452.         applZone^.moreMast := oldMoreMast * callsToMoreMasters;
  453.         MoreMasters;
  454.         applZone^.moreMast := oldMoreMast;
  455.     
  456.         LoadResidentSegments;
  457.     
  458.         InitUObject;                                        { Initialize runtime support for objects }
  459.     
  460.         {$IFC qInspector}
  461.         InitUInspector;
  462.         {$ENDC}
  463.     
  464.         { Force the init segment to be memory resident, so we can call UnloadAllSegs during init }
  465.         initSeg := GetSegNumber(@DoInitUMacApp);
  466.         SetResidentSegment(initSeg, TRUE);
  467.     
  468.         DoInitUMacApp;                                        { do rest of initialization }
  469.     
  470.         SetResidentSegment(initSeg, FALSE);                 { make it non-resident }
  471.         UnloadAllSegments;
  472.         END
  473.     ELSE
  474.         BEGIN
  475.         StdAlert(phUnsupportedConfiguration);
  476.         ExitToShell;
  477.         END;
  478.     END;
  479. {$Pop}
  480.  
  481. {--------------------------------------------------------------------------------------------------}
  482. {$S MAMiniInit}                                         { Must be in MAMiniInit }
  483.  
  484. PROCEDURE ClearTheFPU;
  485.     INLINE $42A7,                                        { CLR.L -(A7) }
  486.            $42A7,                                        { CLR.L -(A7) }
  487.            $F21F, $9800;                                { FMOVEM (A7)+, FPCR/FPSR }
  488.  
  489. PROCEDURE InitializationThatMustNotFail;
  490. { Nothing in this routine can fail. }
  491.  
  492.     BEGIN
  493.     { the main procedure is always compiled with universal code so, the FPU must be reset before it
  494.     is used.  We could get spurious crashes or worse.
  495.  
  496.     Remember: 2+2=4… every time!
  497.     }
  498.     IF qNeedsFPU | gConfiguration.hasFPU THEN
  499.         ClearTheFPU;
  500.  
  501.     InitUPatch;
  502.  
  503.     {$IFC qDebug}
  504.     gExperimenting := FALSE;
  505.     gDebugPrinting := FALSE;
  506.     gReportMenuChoices := FALSE;
  507.     gIntenseDebugging := FALSE;
  508.     gReportEvt := FALSE;
  509.     gMastReport := FALSE;
  510.     gRsrcReport := FALSE;
  511.     gMemMgtBreak := FALSE;
  512.     {$ENDC}
  513.  
  514.     { the following set up is necessary to call CleanupMacApp }
  515.     gApplication := NIL;
  516.  
  517.  
  518.     gMacAppAlertFilter := NIL;
  519.  
  520.     { !!! The alert filter is pretty good but… its new enough, and changes behaviour enough that
  521.     we are more comfortable NOT installing it by default in this release (2.0).  If you wish
  522.     to use it and are not using the qExperimentalAndUnsupported flag then just assign its address
  523.     into gMacAppAlertFilter in you IYourApplication method. }
  524.  
  525.     {$IFC qExperimentalAndUnsupported}
  526.     gMacAppAlertFilter := @MacAppAlertFilter;
  527.     {$EndC}
  528.  
  529.     gInFilter := FALSE;
  530.     gInhibitNestedHandling := FALSE;                    { Allow nested handling }
  531.     
  532.     {$IFC qExperimentalAndUnsupported}
  533.     gEnableDoubleBuffering := TRUE;
  534.     {$EndC}
  535.  
  536.     FailNil(gCursorRgn);
  537.     END;
  538. {--------------------------------------------------------------------------------------------------}
  539. {$S MAInit}                                             { Must be in the init segment; unloaded at
  540.                                                          start of event loop }
  541.  
  542. PROCEDURE DoInitUMacApp;
  543.  
  544.     VAR
  545.         message:            INTEGER;
  546.         {$IFC qDebug}
  547.         gDebugKeyMap:        KeyMap;                     { the key state at start-up time }
  548.         {$ENDC}
  549.         fontSize, fontNum:            INTEGER;
  550.  
  551.     BEGIN
  552.     InitUBusyCursor;
  553.     FailOsErr(HeadPatch(pETSPatch, _ExitToShell, @CleanupMacApp));
  554.     BusyInstall;
  555.  
  556.     gAlwaysTrackCursor := FALSE;
  557.  
  558.     gMainEventMask := everyEvent;
  559.  
  560.     pCopyright := NewString(kCopyright);
  561.  
  562.     {$IFC qDebug}
  563.     gRsrcCheck := kRsrcCheckInterval;
  564.     gAssumeFocused := TRUE;                             { make TView.AssumeFocused actually check
  565.                                                          focus }
  566.     {$ENDC}
  567.  
  568.     { Other 1-time initialization }
  569.     gTempRgn := MakeNewRgn;
  570.     gSaveFocusRec.Clip := MakeNewRgn;
  571.  
  572.     gClickCount := 0;
  573.     gLastUpTime := TickCount;
  574.     gLastClickPart := inDesk;
  575.     gIdlePhase := idleEnd;
  576.     gInBackground := FALSE;                             { When we start an app, it's in foreground }
  577.     gLastDeskAcc := gLastUpTime;
  578.  
  579.     gWResSignature := kNoIdentifier;
  580.     gWResType := '';
  581.  
  582.     { Create a work port for our convenience }
  583.     gWorkPort := @gFakeWindow;
  584.     IF qNeedsColorQD | gConfiguration.hasColorQD THEN
  585.         OpenCPort(CGrafPtr(gWorkPort))
  586.     ELSE
  587.         OpenPort(gWorkPort);
  588.  
  589.     gFakeWindow.ControlList := NIL;
  590.  
  591.     gNextSpaceMsg := gLastUpTime;
  592.     gLowSpaceInterval := kLowSpaceInterval;
  593.  
  594.     {$IFC qDebug}
  595.     gBusyTempRgn := FALSE;
  596.     gUsedBy := '';
  597.     {$ENDC}
  598.  
  599.     gNoChanges := NIL;                                    { Left in for compatibility (2.0) }
  600.     gStdHysteresis := Point($00040004);                 { ??? any better choice ??? }
  601.  
  602.     SetPt(gZeroPt, 0, 0);
  603.     SetRect(gZeroRect, 0, 0, 0, 0);
  604.     SetVPt(gZeroVPt, 0, 0);
  605.     SetVRect(gZeroVRect, 0, 0, 0, 0);
  606.  
  607.     WITH GetGrayRgn^^.rgnBBox DO
  608.         BEGIN
  609.         SetRect(gStdWMoveBounds, left + 4, top + 4, right - 4, bottom - 4);
  610.  
  611.         { arbitrary minimum size; maximum size is grayRgn size minus half the title bar }
  612.         SetRect(gStdWSizeRect, 80, 80, right, bottom - 8 { half a title bar } );
  613.  
  614.         SetRect(gStdWScreenRect, left + 16, top + 16, right - 16, bottom - 16);
  615.         END;
  616.  
  617.     gOrthogonal[v] := h;
  618.     gOrthogonal[h] := v;
  619.  
  620.     gPrinting := FALSE;
  621.     gCurrPrintHandler := NIL;
  622.     gDrawingPictScrap := FALSE;
  623.     gDrawingPictScrapView := NIL;
  624.  
  625.     gFinderPrinting := FALSE;
  626.     gCouldPrint := FALSE;
  627.  
  628.     CountAppFiles(message, gFileCount);
  629.     gFinderPrinting := (message = appPrint);
  630.  
  631.     gHeadCohandler := NIL;
  632.     gEventLevel := 1;                                    { Prevents UnloadAllSegs from getting called
  633.                                                          if a modal dialogs is used befure starting
  634.                                                          the main event loop }
  635.  
  636.     New(gNullPrintHandler);
  637.     FailNil(gNullPrintHandler);
  638.     gNullPrintHandler.IPrintHandler(NIL);
  639.  
  640.     gPrintHandler := gNullPrintHandler;
  641.  
  642.     gFreeWindowList := NewList;
  643.  
  644.     {$IFC qDebug}
  645.     gFreeWindowList.SetEltType('TWindow');
  646.     {$ENDC}
  647.  
  648.     gChooserOK := TRUE;
  649.  
  650.     gClipWindow := NIL;
  651.  
  652.     gGotClipType := FALSE;
  653.  
  654.     gClipView := NIL;
  655.     gClipUndoView := NIL;
  656.  
  657.     gNumUntitled := 1;                                    { call the first document Untitled-1 }
  658.  
  659.     gUndoState := kShowUndo;
  660.     gUndoCmd := cNoCommand;
  661.     gErrorParm3 := '';
  662.     gFocusedView := NIL;
  663.     gStdStaggerCount := 0;
  664.  
  665.     gMBarDisplayed := kMBarDisplayed;
  666.     gMBarNotDisplayed := kMBarNotDisplayed;
  667.     gMBarHierarchical := kMBarHierarchical;
  668.  
  669.     { Compute the system font size, to be stuffed into gSystemStyle… }
  670.  
  671.     IF qNeedsScriptManager | gConfiguration.hasScriptManager THEN
  672.         fontSize := GetDefFontSize
  673.     ELSE IF qNeedsROM128K | gConfiguration.hasROM128K THEN
  674.         fontSize := IntegerPtr(kLMSysFontSize)^
  675.     ELSE
  676.         fontSize := 12;                                 { Guess }
  677.     SetTextStyle(gSystemStyle, systemFont, [], fontSize, gRGBBlack);
  678.  
  679.     SetTextStyle(gApplicationStyle, applFont, [], 0, gRGBBlack);
  680.  
  681.     gOldChooserFlag := SetChooserAlert(FALSE);
  682.  
  683.     gSignatureCount := 0;
  684.  
  685.     IF qTemplateViews THEN
  686.         BEGIN
  687.         { =============================================== }
  688.         { Suppress Linker dead stripping of these classes }
  689.  
  690.         IF gDeadStripSuppression THEN
  691.             BEGIN
  692.             IF Member(TObject(NIL), TView) THEN;
  693.             IF Member(TObject(NIL), TWindow) THEN;
  694.             IF Member(TObject(NIL), TScrollBar) THEN;
  695.             IF Member(TObject(NIL), TSScrollBar) THEN;
  696.             IF Member(TObject(NIL), TScroller) THEN;
  697.             IF Member(TObject(NIL), TDeskScrapView) THEN;
  698.  
  699.             IF Member(TObject(NIL), TDocument) THEN;
  700.             IF Member(TObject(NIL), TNoChangesCommand) THEN;
  701.             IF Member(TObject(NIL), TList) THEN;
  702.             END;
  703.         { =============================================== }
  704.  
  705.         RegisterStdType('TView', kStdView);
  706.         RegisterStdType('TView', kStdDefaultView);
  707.         RegisterStdType('TWindow', kStdWindow);
  708.         RegisterStdType('TSScrollBar', kStdSScrollBar);
  709.         RegisterStdType('TScroller', kStdScroller);
  710.  
  711.         RegisterStdType('TDocument', kStdDocument);
  712.         RegisterStdType('TNoChangesCommand', kStdTracker);
  713.         RegisterStdType('TList', kStdList);
  714.         END;
  715.  
  716.     {$IFC qDebug}
  717.     gTraceSetupMenus := FALSE;
  718.     gTraceIdle := FALSE;
  719.     InitUDebug(NIL, NIL, @EntDebugger, @InspectObject,
  720.                @LookupSymbol);
  721.  
  722.     IF TrcEnable(TRUE) THEN;                            { Discard Result }
  723.     {$ENDC}
  724.  
  725.     InitUMenuSetup;
  726.  
  727.     {$IFC qDebug}
  728.     IF cUndo - cEditBase <> kSysUndo THEN
  729.         WriteLn('Invalid UNDO command number');
  730.     IF cCut - cEditBase <> kSysCut THEN
  731.         WriteLn('Invalid CUT command number');
  732.     IF cCopy - cEditBase <> kSysCopy THEN
  733.         WriteLn('Invalid COPY command number');
  734.     IF cPaste - cEditBase <> kSysPaste THEN
  735.         WriteLn('Invalid PASTE command number');
  736.     IF cClear - cEditBase <> kSysClear THEN
  737.         WriteLn('Invalid CLEAR command number');
  738.     {$ENDC}
  739.  
  740.     {$IFC qDebug}
  741.     GetKeys(gDebugKeyMap);
  742.     IF gDebugKeyMap[55] & gDebugKeyMap[56] & gDebugKeyMap[58] THEN { cmd-shift-option }
  743.         ProgramBreak('At start of application');
  744.     {$ENDC}
  745.  
  746.     END;
  747.  
  748. {--------------------------------------------------------------------------------------------------}
  749. {$S MARes}
  750.  
  751. PROCEDURE InstallIfPrintHandler(aPrintHandler: TPrintHandler; aView: TView);
  752.  
  753.     VAR
  754.         aNewPrintHandler: TPrintHandler;
  755.  
  756.     BEGIN
  757.     IF (aPrintHandler <> gNullPrintHandler) & (gPrintHandler <> gNullPrintHandler) &
  758.        (aPrintHandler <> NIL) & (aView <> NIL) THEN
  759.         BEGIN
  760.         aNewPrintHandler := TPrintHandler(aPrintHandler.clone);
  761.         IF aPrintHandler <> NIL THEN
  762.             BEGIN
  763.             IF aView.fDocument <> NIL THEN
  764.                 BEGIN
  765.                 aView.fDocument.fDocPrintHandler := aNewPrintHandler;
  766.                 aNewPrintHandler.fDocument := aView.fDocument;
  767.                 END;
  768.             aNewPrintHandler.fView := aView;
  769.             aNewPrintHandler.SetDefaultPrintInfo;
  770.             aView.AttachPrintHandler(aNewPrintHandler);
  771.             END;
  772.         END;
  773.     END;
  774.  
  775. {--------------------------------------------------------------------------------------------------}
  776. {$S MAError}
  777.  
  778. FUNCTION LookupErrString(value: INTEGER;
  779.                          resourceID: INTEGER;
  780.                          VAR str: Str255): BOOLEAN;
  781.  
  782.     FUNCTION SearchTable(value: INTEGER;
  783.                          resourceID: INTEGER;
  784.                          VAR str: Str255): BOOLEAN;
  785.  
  786.         LABEL 1;
  787.  
  788.         TYPE
  789.             ErrRecordHandle     = ^ErrRecord;
  790.             ErrRecord            = RECORD
  791.                 lowErr, highErr, index: INTEGER;
  792.                 END;
  793.  
  794.         VAR
  795.             table:                Handle;
  796.             pEntry:             ErrRecordHandle;
  797.             tableOffset:        LongInt;
  798.             lenTab:             INTEGER;
  799.             strID:                INTEGER;
  800.             i:                    INTEGER;
  801.  
  802.         BEGIN
  803.         SearchTable := FALSE;
  804.         str := '';
  805.  
  806.         table := GetResource('errs', resourceID);
  807.         IF table <> NIL THEN
  808.             BEGIN
  809.             lenTab := GetHandleSize(Handle(table)) DIV SIZEOF(ErrRecord);
  810.  
  811.             strID := 0;
  812.             tableOffset := 0;
  813.  
  814.             FOR i := 1 TO lenTab DO
  815.                 BEGIN
  816.                 pEntry := ErrRecordHandle(Ord4(table^) + tableOffset);
  817.  
  818.                 WITH pEntry^ DO
  819.                     BEGIN
  820.                     IF lowErr = 0 THEN
  821.                         strID := index
  822.                     ELSE IF (lowErr <= value) & (value <= highErr) THEN
  823.                         BEGIN
  824.                         IF index > 0 THEN
  825.                             GetIndString(str, strID, index);
  826.                         SearchTable := TRUE;
  827.                         GOTO 1;                         { exit the loop }
  828.                         END;
  829.                     END;
  830.  
  831.                 tableOffset := tableOffset + SIZEOF(ErrRecord);
  832.                 END;
  833.         1:
  834.             END;
  835.         END;
  836.  
  837.     BEGIN
  838.     IF SearchTable(value, errAppTable + resourceID, str) THEN
  839.         LookupErrString := TRUE
  840.     ELSE
  841.         LookupErrString := SearchTable(value, resourceID, str);
  842.     END;
  843.  
  844. {--------------------------------------------------------------------------------------------------}
  845. {$S MADebug}
  846.  
  847. FUNCTION LookupSymbol(VAR sym: Str255): LongInt;
  848.  
  849.     BEGIN
  850.     IF gInitialized THEN
  851.         LookupSymbol := gTarget.LookupSymbol(sym)
  852.     ELSE
  853.         LookupSymbol := - 1;
  854.     END;
  855.  
  856. {--------------------------------------------------------------------------------------------------}
  857. {$S MAGlobalsRes}                                        { Don't require a segment load for this }
  858.  
  859. VAR
  860.     bufferString:        String8;                        { If any script has a character with more
  861.                                                          than 8 bytes then the creatures that speak
  862.                                                          that language have too many fingers! }
  863.  
  864. FUNCTION MacAppAlertFilter(theDialog: DialogPtr;
  865.                            VAR theEvent: EventRecord;
  866.                            VAR itemHit: INTEGER): BOOLEAN;
  867.  
  868. { MacAppAlertFilter is a default filterProc used by MacAppAlert if the filterProc passed in is NIL.
  869.   It maps key strokes to the first character of button item titles.  It also hands off activate
  870.   and update processing to gApplication if we're not being called from an error condition or
  871.   while nested. }
  872.  
  873.     LABEL 1000;
  874.  
  875.     VAR
  876.         theChar:            CHAR;
  877.         itemType:            INTEGER;
  878.         item:                Handle;
  879.         box:                Rect;
  880.         byteType:            INTEGER;
  881.         fi:                 FailInfo;
  882.         oldInFilterState:    BOOLEAN;
  883.         anEvent:            EventRecord;
  884.  
  885.     PROCEDURE HdlFilter(error: INTEGER;
  886.                         message: LongInt);
  887.  
  888.         BEGIN
  889.         GOTO 1000;
  890.         END;
  891.  
  892.     FUNCTION GetButtonTitle(itemNo: INTEGER): String8;
  893.     { Retrieve the title of the button control.
  894.       If itemNo isn't a button, then return ''. }
  895.  
  896.         VAR
  897.             title:                Str255;
  898.  
  899.         BEGIN
  900.         GetDItem(theDialog, itemNo, itemType, item, box);
  901.         IF itemType <> (ctrlItem + btnCtrl) THEN
  902.             title := ''
  903.         ELSE
  904.             GetCTitle(ControlHandle(item), title);
  905.         GetButtonTitle := title;
  906.         END;
  907.  
  908.     PROCEDURE DoKeyDown(itemNo: INTEGER);
  909.     { Handle a keypress that has been mapped to one of the button controls. }
  910.  
  911.         VAR
  912.             finalTicks:         LongInt;
  913.  
  914.         BEGIN
  915.         MacAppAlertFilter := TRUE;
  916.         itemHit := itemNo;
  917.         GetDItem(theDialog, itemNo, itemType, item, box);
  918.         IF itemType = (ctrlItem + btnCtrl) THEN
  919.             BEGIN                                        { this code gives visual feedback }
  920.             HiliteControl(ControlHandle(item), inButton); { hilite the button }
  921.             Delay(8, finalTicks);                        { delay for 8 ticks }
  922.             HiliteControl(ControlHandle(item), 0);        { stop hiliting the button }
  923.             END;
  924.         END;
  925.  
  926.     FUNCTION TestAString(aString: String8): BOOLEAN;
  927.     { in the case of Script Manager systems, use CharByte to determine character boundaries
  928.       and compare the input to the button titles }
  929.  
  930.         VAR
  931.             textOffset:         INTEGER;
  932.             done, areEqual:     BOOLEAN;
  933.  
  934.         BEGIN
  935.         textOffset := 0;
  936.         done := FALSE;
  937.         REPEAT
  938.             IF qNeedsScriptManager | gConfiguration.hasScriptManager THEN
  939.                 byteType := CharByte(@aString[1], textOffset) { textOffset is zero-based }
  940.             ELSE
  941.                 byteType := smSingleByte;
  942.  
  943.             textOffset := textOffset + 1;
  944.             areEqual := aString[textOffset] = bufferString[textOffset];
  945.             CASE byteType OF
  946.                 smSingleByte:
  947.                     BEGIN                                { special case single byte characters to
  948.                                                          allow lower case characters to map to
  949.                                                          upper case characters }
  950.                     areEqual := LowerChar(aString[1]) = LowerChar(bufferString[1]);
  951.                     done := TRUE;
  952.                     END;
  953.                 smFirstByte:
  954.                     done := NOT areEqual;                { we're done if they don't match }
  955.                 smLastByte:
  956.                     done := TRUE;
  957.                 smMiddleByte:
  958.                     done := NOT areEqual;                { we're done if they don't match }
  959.             END;
  960.         UNTIL done;
  961.         TestAString := areEqual;
  962.         END;
  963.  
  964.     PROCEDURE DoAddByte(theChar: CHAR);
  965.     { adds the incoming byte to the bufferString of typed characters }
  966.  
  967.         VAR
  968.             buffIndex:            INTEGER;
  969.  
  970.         BEGIN
  971.         buffIndex := ORD(bufferString[0]) + 1;            { increment count }
  972.         bufferString[buffIndex] := theChar;             { assign new character }
  973.         bufferString[0] := CHR(buffIndex);                { assign length byte }
  974.         END;
  975.  
  976.     PROCEDURE DoLastByte(theChar: CHAR);
  977.     { adds the last incoming byte to the bufferString of typed characters
  978.     and compares the bufferString to the first character of each button title
  979.     1st button in alert (by convention = "OK").  2nd button in alert (by convention =
  980.     "Cancel").    3rd button in alert (by convention = "No") }
  981.  
  982.         BEGIN
  983.         DoAddByte(theChar);
  984.         IF TestAString(GetButtonTitle(ok)) THEN
  985.             DoKeyDown(ok)
  986.         ELSE IF TestAString(GetButtonTitle(cancel)) THEN
  987.             DoKeyDown(cancel)
  988.         ELSE IF TestAString(GetButtonTitle(kNoButton)) THEN
  989.             DoKeyDown(kNoButton);
  990.         bufferString := '';                             { initialize bufferString }
  991.         END;
  992.  
  993.     BEGIN                                                { MacAppAlertFilter }
  994.     MacAppAlertFilter := FALSE;
  995.     oldInFilterState := gInFilter;
  996.     gInFilter := TRUE;
  997.     CatchFailures(fi, HdlFilter);
  998.  
  999.     { Wouldn't want MacApp to get lied to about where the focus _Actually_ is }
  1000.     IF (gApplication <> NIL) & NOT gInhibitNestedHandling & NOT oldInFilterState THEN
  1001.         gApplication.InvalidateFocus;
  1002.  
  1003.     CASE theEvent.what OF
  1004.         activateEvt:                                    { this is the first event the alert gets, so
  1005.                                                          let's determine our VARs }
  1006.             BEGIN
  1007.             IF DialogPtr(theEvent.message) = theDialog THEN
  1008.                 BEGIN
  1009.                 bufferString := '';                     { initialize bufferString }
  1010.                 END
  1011.             ELSE IF (gApplication <> NIL) & NOT gInhibitNestedHandling & NOT oldInFilterState THEN
  1012.                 gApplication.HandleEvent(theEvent);
  1013.             END;
  1014.  
  1015.         updateEvt:                                        { this is the first event the alert gets, so
  1016.                                                          let's determine our VARs }
  1017.             BEGIN
  1018.             IF DialogPtr(theEvent.message) <> theDialog THEN
  1019.                 IF (gApplication <> NIL) & NOT gInhibitNestedHandling & NOT oldInFilterState THEN
  1020.                     gApplication.HandleEvent(theEvent);
  1021.             END;
  1022.         keyDown:                                        { let's determine if the key pressed
  1023.                                                          corresponds to our button titles }
  1024.             BEGIN
  1025.             theChar := CHR(BAND(theEvent.message, charCodeMask));
  1026.             IF qNeedsScriptManager | gConfiguration.hasScriptManager THEN
  1027.                 byteType := CharByte(@theChar, 0)
  1028.             ELSE
  1029.                 byteType := smLastByte;                 { punt...treat each byte as the last
  1030.                                                          character }
  1031.             CASE byteType OF
  1032.                 smSingleByte:
  1033.                     IF (theChar = chEnter) | (theChar = chReturn) THEN
  1034.                         DoKeyDown(ok)
  1035.                     ELSE IF (theChar = chEscape) | ((theChar = '.') & (BAND(theEvent.modifiers,
  1036.                             cmdKey) <> 0)) THEN
  1037.                         DoKeyDown(cancel)
  1038.                     ELSE
  1039.                         DoLastByte(theChar);
  1040.                 smFirstByte:
  1041.                     DoAddByte(theChar);
  1042.                 smLastByte:
  1043.                     DoLastByte(theChar);
  1044.                 smMiddleByte:
  1045.                     DoAddByte(theChar);
  1046.             END;                                        { CASE }
  1047.             END;
  1048.     END;
  1049.  
  1050.     { Idle but only if _REALLY_ necessary }
  1051.     IF (gApplication <> NIL) & NOT gInhibitNestedHandling & NOT oldInFilterState &
  1052.        NOT EventAvail(everyEvent, anEvent) THEN
  1053.         gApplication.Idle(gIdlePhase);
  1054.  
  1055.     Success(fi);
  1056. 1000:
  1057.     gInFilter := oldInFilterState;
  1058.     END;                                                { MacAppAlertFilter }
  1059.  
  1060. {--------------------------------------------------------------------------------------------------}
  1061. {$Push}
  1062. {$MC68020-}                                             { Need to be able to alert user if this
  1063.                                                          isn't a 68020 machine, alert filter won't
  1064.                                                          be installed until after that, though. }
  1065. {$S MAGlobalsRes}                                        { Don't require a segment load for this }
  1066.  
  1067. FUNCTION MacAppAlert(alertID: INTEGER;
  1068.                      filterProc: ProcPtr): INTEGER;
  1069.  
  1070.     VAR
  1071.         alrtTemplate:        AlertTHndl;
  1072.     
  1073.     FUNCTION CanAlert:Boolean;                            { ensures that the Alert won't fail }
  1074.  
  1075.         BEGIN
  1076.         CouldAlert(alertID);
  1077.         CanAlert := (ResError = NoErr) & (MemError = NoErr);
  1078.         FreeAlert(alertID);
  1079.         END;
  1080.  
  1081.     BEGIN
  1082.     {$IFC qDebug}
  1083.     gRsrcCheck := 0;                                    { force immediate check. }
  1084.     {$ENDC}
  1085.  
  1086.     SetCursor(arrow);
  1087.     alrtTemplate := AlertTHndl(GetResource('ALRT', alertID));
  1088.     IF alrtTemplate <> NIL THEN
  1089.         BEGIN
  1090.         IF GetResource('DITL', alertID) = NIL THEN        { preflight the DITL }
  1091.             BEGIN                                        { DITL is missing or not enough memory }
  1092.             {$IFC qDebug}
  1093.             ProgramBreak(ConcatNumber('Unable to find or load ‘DITL’ resource ', alertID));
  1094.             {$ENDC}
  1095.             SysBeep(2);                                 { At least give some indication }
  1096.             MacAppAlert := 1;                            { Arbitrary result }
  1097.             END
  1098.         ELSE
  1099.             BEGIN
  1100.             IF NOT CanAlert THEN
  1101.                 BEGIN                                    { no can do }
  1102.                 {$IFC qDebug}
  1103.                 ProgramBreak(ConcatNumber('Unable to display alert ', alertID));
  1104.                 {$ENDC}
  1105.                 SysBeep(2);                             { At least give some indication }
  1106.                 MacAppAlert := 1;                        { Arbitrary result }
  1107.                 END
  1108.             ELSE
  1109.                 BEGIN
  1110.                 LockHandleHigh(Handle(alrtTemplate));
  1111.                 CenterRectOnScreen(alrtTemplate^^.boundsRect, TRUE, TRUE, TRUE);
  1112.                 PullApplicationToFront;
  1113.                 IF (filterProc = NIL) THEN
  1114.                     MacAppAlert := Alert(alertID, gMacAppAlertFilter)
  1115.                 ELSE
  1116.                     MacAppAlert := Alert(alertID, filterProc);
  1117.                 END
  1118.             END
  1119.         END
  1120.     ELSE
  1121.         BEGIN
  1122.         {$IFC qDebug}
  1123.         ProgramBreak(ConcatNumber('Unable to find or load ‘ALRT’ resource ', alertID));
  1124.         {$ENDC}
  1125.         SysBeep(2);                                     { At least give some indication }
  1126.         MacAppAlert := 1;                                { Arbitrary result }
  1127.         END;
  1128.  
  1129.     IF gApplication <> NIL THEN
  1130.         gApplication.InvalidateCursorRgn;
  1131.  
  1132.     InvalidateMenus;
  1133.     END;
  1134. {$Pop}
  1135.  
  1136. {--------------------------------------------------------------------------------------------------}
  1137. {$S MAGlobalsRes}
  1138.  
  1139. FUNCTION MakeNewRgn: RgnHandle;
  1140.  
  1141.     VAR
  1142.         aRgn:                RgnHandle;
  1143.  
  1144.     BEGIN
  1145.     aRgn := NewRgn;
  1146.     FailNil(aRgn);
  1147.     MakeNewRgn := aRgn;
  1148.     END;
  1149.  
  1150. {--------------------------------------------------------------------------------------------------}
  1151. {$S MAOpen}
  1152.  
  1153. FUNCTION NewPaletteWindow(itsRsrcID: INTEGER;
  1154.                           wantHScrollBar, wantVScrollBar: BOOLEAN;
  1155.                           itsDocument: TDocument;
  1156.                           itsMainView: TView;
  1157.                           itsPaletteView: TView;
  1158.                           sizePalette: INTEGER;
  1159.                           whichWay: VHSelect): TWindow;
  1160.  
  1161.     VAR
  1162.         aWindow:            TWindow;
  1163.         aScroller:            TScroller;
  1164.         fi:                 FailInfo;
  1165.         itsSize:            VPoint;
  1166.         itsLocation:        VPoint;
  1167.         wSize:                Point;
  1168.         sBarOffsets:        VRect;
  1169.  
  1170.     PROCEDURE HdlNPWindow(error: INTEGER;
  1171.                           message: LongInt);
  1172.  
  1173.         BEGIN
  1174.         FreeIfObject(aWindow);
  1175.         aWindow := NIL;
  1176.         END;
  1177.  
  1178.     BEGIN
  1179.     aWindow := NewTWindow(itsRsrcID, itsDocument);
  1180.  
  1181.     WITH aWindow.fResizeLimits.topLeft DO
  1182.         vh[whichWay] := vh[whichWay] + sizePalette;
  1183.  
  1184.     CatchFailures(fi, HdlNPWindow);
  1185.  
  1186.     aWindow.AddSubView(itsPaletteView);
  1187.  
  1188.     itsLocation := gZeroVPt;
  1189.     itsLocation.vh[whichWay] := sizePalette;
  1190.     IF wantHScrollBar | wantVScrollBar THEN
  1191.         BEGIN
  1192.         sBarOffsets := gZeroVRect;
  1193.         itsSize := aWindow.fSize;
  1194.         IF wantHScrollBar THEN
  1195.             BEGIN
  1196.             itsSize.v := itsSize.v - kSBarSizeMinus1;
  1197.             IF NOT wantVScrollBar THEN
  1198.                 sBarOffsets.right := - kSBarSizeMinus1;
  1199.             END;
  1200.         IF wantVScrollBar THEN
  1201.             BEGIN
  1202.             itsSize.h := itsSize.h - kSBarSizeMinus1;
  1203.             IF NOT wantHScrollBar THEN
  1204.                 sBarOffsets.bottom := - kSBarSizeMinus1;
  1205.             END;
  1206.         itsSize.vh[whichWay] := itsSize.vh[whichWay] - sizePalette;
  1207.         New(aScroller);
  1208.         FailNil(aScroller);
  1209.         aScroller.IScroller(aWindow, itsLocation, itsSize, sizeRelSuperView, sizeRelSuperView, 0, 0,
  1210.                             wantHScrollBar, wantVScrollBar);
  1211.         aScroller.fSBarOffsets := sBarOffsets;
  1212.         aScroller.AddSubView(itsMainView);
  1213.         END
  1214.     ELSE
  1215.         aWindow.AddSubView(itsMainView);
  1216.  
  1217.     aWindow.SetTarget(itsMainView);
  1218.  
  1219.     { make frames be the right size }
  1220.     WITH aWindow.fWMgrWindow^.portRect DO
  1221.         BEGIN
  1222.         wSize := botRight;
  1223.         {$Push} {$H-}
  1224.         SubPt(topLeft, wSize);
  1225.         {$Pop}
  1226.         END;
  1227.     aWindow.Resize(wSize.h, wSize.v, kDontInvalidate);
  1228.  
  1229.     NewPaletteWindow := aWindow;
  1230.  
  1231.     Success(fi);
  1232.     END;
  1233.  
  1234. {--------------------------------------------------------------------------------------------------}
  1235. {$S MAOpen}
  1236.  
  1237. FUNCTION NewSimpleWindow(itsRsrcID: INTEGER;
  1238.                          wantHScrollBar, wantVScrollBar: BOOLEAN;
  1239.                          itsDocument: TDocument;
  1240.                          itsView: TView): TWindow;
  1241.  
  1242.     VAR
  1243.         aWindow:            TWindow;
  1244.         aScroller:            TScroller;
  1245.         fi:                 FailInfo;
  1246.         itsSize:            VPoint;
  1247.         wSize:                Point;
  1248.         sBarOffsets:        VRect;
  1249.  
  1250.     PROCEDURE HdlNSWindow(error: INTEGER;
  1251.                           message: LongInt);
  1252.  
  1253.         BEGIN
  1254.         FreeIfObject(aWindow);
  1255.         aWindow := NIL;
  1256.         END;
  1257.  
  1258.     BEGIN
  1259.     aWindow := NewTWindow(itsRsrcID, itsDocument);
  1260.  
  1261.     aScroller := NIL;
  1262.  
  1263.     CatchFailures(fi, HdlNSWindow);
  1264.  
  1265.     IF wantHScrollBar | wantVScrollBar THEN
  1266.         BEGIN
  1267.         sBarOffsets := gZeroVRect;
  1268.         itsSize := aWindow.fSize;
  1269.         IF wantHScrollBar THEN
  1270.             BEGIN
  1271.             itsSize.v := itsSize.v - kSBarSizeMinus1;
  1272.             IF NOT wantVScrollBar THEN
  1273.                 sBarOffsets.right := - kSBarSizeMinus1;
  1274.             END;
  1275.         IF wantVScrollBar THEN
  1276.             BEGIN
  1277.             itsSize.h := itsSize.h - kSBarSizeMinus1;
  1278.             IF NOT wantHScrollBar THEN
  1279.                 sBarOffsets.bottom := - kSBarSizeMinus1;
  1280.             END;
  1281.         New(aScroller);
  1282.         FailNil(aScroller);
  1283.         aScroller.IScroller(aWindow, gZeroVPt, itsSize, sizeRelSuperView, sizeRelSuperView, 0, 0,
  1284.                             wantHScrollBar, wantVScrollBar);
  1285.         aScroller.fSBarOffsets := sBarOffsets;
  1286.         IF itsView <> NIL THEN
  1287.             aScroller.AddSubView(itsView);
  1288.         END
  1289.     ELSE IF itsView <> NIL THEN
  1290.         aWindow.AddSubView(itsView);
  1291.  
  1292.     aWindow.SetTarget(itsView);
  1293.  
  1294.     { make sure window and subviews are the right size }
  1295.     WITH aWindow.fWMgrWindow^.portRect DO
  1296.         BEGIN
  1297.         wSize := botRight;
  1298.         {$Push} {$H-}
  1299.         SubPt(topLeft, wSize);
  1300.         {$Pop}
  1301.         END;
  1302.     aWindow.Resize(wSize.h, wSize.v, kDontInvalidate);
  1303.  
  1304.     NewSimpleWindow := aWindow;
  1305.  
  1306.     Success(fi);
  1307.     END;
  1308.  
  1309. {--------------------------------------------------------------------------------------------------}
  1310. {$S MAOpen}
  1311.  
  1312. FUNCTION NewStdObject(signature: IDType): TObject;
  1313.  
  1314.     VAR
  1315.         i:                    INTEGER;
  1316.         obj:                TObject;
  1317.  
  1318.     BEGIN
  1319.     FOR i := 1 TO gSignatureCount DO
  1320.         IF LongInt(gSignatures[i]) = LongInt(signature) THEN
  1321.             BEGIN
  1322.             NewStdObject := NewObjectByClassId(gSignatureIds[i]);
  1323.             EXIT(NewStdObject);
  1324.             END;
  1325.  
  1326.     {$IFC qDebug}
  1327.     WriteLn('signature=‘', signature, '’');
  1328.     ProgramBreak('Unable to find class for the given signature');
  1329.     {$ENDC}
  1330.     NewStdObject := NIL;
  1331.     END;
  1332.  
  1333. {--------------------------------------------------------------------------------------------------}
  1334. {$S MAOpen}
  1335.  
  1336. FUNCTION NewTWindow(itsRsrcID: INTEGER;
  1337.                     itsDocument: TDocument): TWindow;
  1338.  
  1339.     VAR
  1340.         aWMgrWindow:        WindowPtr;
  1341.         aWindow:            TWindow;
  1342.         canResize:            BOOLEAN;
  1343.         canClose:            BOOLEAN;
  1344.         fi:                 FailInfo;
  1345.  
  1346.     PROCEDURE HdlNewWObj(error: INTEGER;
  1347.                          message: LongInt);
  1348.  
  1349.         BEGIN
  1350.         { the wmgrWindow is known to exist }
  1351.   { Since aWindow didn't get created, the wmgrWindow won't be
  1352.    freed unless we do it here. }
  1353.  
  1354.         aWMgrWindow := FreeIfWMgrWindow(aWMgrWindow, TRUE);
  1355.  
  1356.         END;
  1357.  
  1358.     BEGIN
  1359.     aWMgrWindow := NIL;
  1360.     aWMgrWindow := gApplication.GetRsrcWindow(NIL, itsRsrcID, canResize, canClose);
  1361.     { GetRsrcWindow signals Failure }
  1362.  
  1363.     CatchFailures(fi, HdlNewWObj);
  1364.  
  1365.     aWindow := NIL;
  1366.  
  1367.     New(aWindow);
  1368.     FailNil(aWindow);
  1369.     Success(fi);
  1370.  
  1371.     aWindow.IWindow(itsDocument, aWMgrWindow, canResize, canClose, TRUE); { TRUE means can dispose
  1372.                                                                            wmgr window }
  1373.  
  1374.     NewTWindow := aWindow;
  1375.  
  1376.     END;
  1377.  
  1378. {--------------------------------------------------------------------------------------------------}
  1379. {$S MAOpen}
  1380.  
  1381. FUNCTION NewTemplateWindow(viewRsrcID: INTEGER;
  1382.                            itsDocument: TDocument): TWindow;
  1383.  
  1384.     VAR
  1385.         theWindow:            TWindow;
  1386.         theTarget:            TView;
  1387.         aView:                TView;
  1388.  
  1389.     BEGIN
  1390.     theWindow := NIL;
  1391.  
  1392.     aView := gTarget.DoCreateViews(itsDocument, NIL, viewRsrcID, gZeroVPt);
  1393.     IF aView <> NIL THEN
  1394.         BEGIN
  1395.         IF qDebug & NOT MEMBER(aView, TWindow) THEN
  1396.             ProgramBreak('In NewTemplateWindow: Root view is not a window');
  1397.  
  1398.         theWindow := TWindow(aView);
  1399.  
  1400.         IF theWindow.fWMgrWindow <> NIL THEN
  1401.             WITH theWindow.fWMgrWindow^.portRect DO
  1402.                 theWindow.Resize(right - left, bottom - top, kDontInvalidate);
  1403.         IF theWindow.fTargetID <> kNoIdentifier THEN
  1404.             BEGIN
  1405.             theTarget := theWindow.FindSubView(theWindow.fTargetID);
  1406.             IF theTarget <> NIL THEN
  1407.                 theWindow.SetTarget(theTarget)
  1408.             ELSE IF qDebug THEN
  1409.                 ProgramBreak('The window has no view whose id is fTargetId.');
  1410.             END;
  1411.         END;
  1412.     NewTemplateWindow := theWindow;
  1413.     END;
  1414.  
  1415. {--------------------------------------------------------------------------------------------------}
  1416. {$S MAGlobalsRes}
  1417.  
  1418. FUNCTION NewViewRsrc(VAR p: UNIV Ptr): ViewRsrcHndl;
  1419.  
  1420.     VAR
  1421.         aHandle:            ViewRsrcHndl;
  1422.  
  1423.     BEGIN
  1424.     aHandle := ViewRsrcHndl(NewPermHandle(kViewRsrcExpandAmt));
  1425.     FailNil(aHandle);
  1426.     LockHandleHigh(Handle(aHandle));
  1427.     WITH aHandle^^ DO
  1428.         BEGIN
  1429.         numViews := 0;
  1430.         p := @theViews;
  1431.         END;
  1432.     NewViewRsrc := aHandle;
  1433.     END;
  1434.  
  1435. {--------------------------------------------------------------------------------------------------}
  1436. {$S MADebug}
  1437.  
  1438. PROCEDURE NotYetImplemented(where: Str255);
  1439.  
  1440.     BEGIN
  1441.     Failure(errNotImplemented, 0);
  1442.     END;
  1443.  
  1444. {--------------------------------------------------------------------------------------------------}
  1445. {$S MAOpen}
  1446.  
  1447. PROCEDURE OffsetPtr(VAR p: UNIV LongInt;
  1448.                     offset: LongInt);
  1449.  
  1450.     BEGIN
  1451.     p := p + offset;
  1452.     IF ODD(p) THEN
  1453.         p := p + 1;
  1454.     END;
  1455.  
  1456. {--------------------------------------------------------------------------------------------------}
  1457. {$S MAOpen}
  1458.  
  1459. PROCEDURE OffsetPtrWStr(VAR p: UNIV LongInt;
  1460.                         offset: LongInt);
  1461.  
  1462.     BEGIN
  1463.     OffsetPtr(p, offset - 255 + LENGTH(StringPtr(p + offset - 256)^));
  1464.     END;
  1465.  
  1466. {--------------------------------------------------------------------------------------------------}
  1467. {$S MAGlobalsRes}
  1468.  
  1469. FUNCTION ParseTitleTemplate(VAR itsTemplate: Str255;
  1470.                             VAR preDocname, constTitle: INTEGER): BOOLEAN;
  1471.  
  1472.     CONST
  1473.         kPreDocname         = '<<<';
  1474.         kPreSize            = 3;
  1475.         kPostDocname        = '>>>';
  1476.         kPostSize            = 3;
  1477.  
  1478.     VAR
  1479.         x:                    INTEGER;
  1480.  
  1481.     FUNCTION FindPos(pattern: Str255;
  1482.                      VAR source: Str255): INTEGER;
  1483.  
  1484.         VAR
  1485.             i, j:                INTEGER;
  1486.             position:            INTEGER;
  1487.  
  1488.         BEGIN
  1489.         IF qNeedsScriptManager | gConfiguration.hasScriptManager THEN
  1490.             BEGIN
  1491.             i := 0;
  1492.             REPEAT
  1493.                 i := i + 1;
  1494.                 position := i;
  1495.                 FOR j := 1 TO LENGTH(pattern) DO
  1496.                     IF NOT ((source[i + j - 1] = pattern[j]) & (CharByte(@source, i + j) = 0)) THEN
  1497.                         BEGIN
  1498.                         position := 0;
  1499.                         LEAVE;
  1500.                         END;
  1501.             UNTIL (position > 0) | (i >= LENGTH(source) - LENGTH(pattern) + 1);
  1502.             END
  1503.         ELSE
  1504.             position := POS(pattern, source);
  1505.  
  1506.         FindPos := position;
  1507.         END;
  1508.  
  1509.     BEGIN
  1510.     IF itsTemplate = '' THEN
  1511.         BEGIN
  1512.         preDocname := 1;
  1513.         constTitle := 0;
  1514.         END
  1515.     ELSE
  1516.         BEGIN
  1517.         preDocname := FindPos(kPreDocname, itsTemplate);
  1518.         IF preDocname > 0 THEN
  1519.             BEGIN
  1520.             Delete(itsTemplate, preDocname, kPreSize);
  1521.  
  1522.             x := FindPos(kPostDocname, itsTemplate);
  1523.             IF x = 0 THEN
  1524.                 constTitle := preDocname - 1
  1525.             ELSE
  1526.                 BEGIN
  1527.                 Delete(itsTemplate, x, kPostSize);
  1528.                 constTitle := LENGTH(itsTemplate) - x + preDocname;
  1529.                 END;
  1530.             END;
  1531.         END;
  1532.  
  1533.     ParseTitleTemplate := preDocname > 0;
  1534.     END;
  1535.  
  1536. {--------------------------------------------------------------------------------------------------}
  1537. {$S MAGlobalsRes}
  1538.  
  1539. FUNCTION PtIsVisible(pt: Point): BOOLEAN;
  1540.  
  1541.     BEGIN
  1542.     IF gDrawingPictScrap THEN
  1543.         PtIsVisible := TRUE
  1544.     ELSE
  1545.         PtIsVisible := PtInRgn(pt, thePort^.visRgn) & PtInRgn(pt, thePort^.clipRgn);
  1546.     END;
  1547.  
  1548. {--------------------------------------------------------------------------------------------------}
  1549. {$S MAActivate}
  1550.  
  1551. FUNCTION PutDeskScrapData(aResType: ResType;
  1552.                           aDataHandle: Handle): OSErr;
  1553.  
  1554.     VAR
  1555.         err:                LongInt;
  1556.  
  1557.     BEGIN
  1558.     LockHandleHigh(aDataHandle);
  1559.     err := PutScrap(GetHandleSize(aDataHandle), aResType, aDataHandle^);
  1560.     HUnlock(aDataHandle);
  1561.     {$IFC qDebug}
  1562.     IF err <> noErr THEN
  1563.         WriteLn('Error from PutScrap is: ', err: 1);
  1564.     {$ENDC}
  1565.     PutDeskScrapData := err;
  1566.     END;
  1567.  
  1568. {--------------------------------------------------------------------------------------------------}
  1569. {$S MAGlobalsRes}
  1570.  
  1571. FUNCTION RectIsVisible(r: Rect): BOOLEAN;
  1572.  
  1573.     BEGIN
  1574.     IF gDrawingPictScrap THEN
  1575.         RectIsVisible := TRUE
  1576.     ELSE
  1577.         RectIsVisible := RectInRgn(r, thePort^.visRgn) & RectInRgn(r, thePort^.clipRgn);
  1578.     END;
  1579.  
  1580. {--------------------------------------------------------------------------------------------------}
  1581. {$S MAGlobalsRes}
  1582.  
  1583. PROCEDURE RegisterStdType(typeName: Str255;
  1584.                           signature: IDType);
  1585. { Register or re-register a type and a class }
  1586.  
  1587.     VAR
  1588.         i:                    INTEGER;
  1589.  
  1590.     BEGIN
  1591.     { try to find an existing signature to replace }
  1592.     FOR i := 1 TO gSignatureCount DO
  1593.         IF LongInt(gSignatures[i]) = LongInt(signature) THEN
  1594.             BEGIN
  1595.             gSignatureIds[i] := GetClassIDFromName(typeName);
  1596.             { If the name can't be found it was probably misspelled or dead-stripped }
  1597.             IF gSignatureIds[i] = kNilClass THEN
  1598.                 Failure(minErr, 0);                     {??? need to assign a message???}
  1599.             EXIT(RegisterStdType);
  1600.             END;
  1601.  
  1602.     { not found to replace… add a new one }
  1603.     gSignatureCount := gSignatureCount + 1;
  1604.     {$IFC qDebug}
  1605.     IF gSignatureCount >= kMaxSignatures THEN
  1606.         ProgramBreak('Maximum number of signatures exceeded.');
  1607.     {$ENDC}
  1608.     gSignatures[gSignatureCount] := signature;
  1609.     gSignatureIds[gSignatureCount] := GetClassIDFromName(typeName);
  1610.     END;
  1611.  
  1612. {--------------------------------------------------------------------------------------------------}
  1613. {$S MAGlobalsRes}
  1614.  
  1615. PROCEDURE SetFocus(theFocusRec: FocusRec);
  1616.  
  1617.     BEGIN
  1618.     WITH theFocusRec DO
  1619.         BEGIN
  1620.         SetPort(Port);
  1621.         SetOrigin(Org.h, Org.v);
  1622.         SetClip(Clip);
  1623.         gLongOffset := LongOffset;
  1624.         gFocusedView := FocusedView;
  1625.         gPrinting := printing;
  1626.         gDrawingPictScrap := drawingPictScrap;
  1627.         gDrawingPictScrapView := drawingPictScrapView;
  1628.         END;
  1629.     END;
  1630.  
  1631. {--------------------------------------------------------------------------------------------------}
  1632. {$S MAGlobalsRes}
  1633.  
  1634. PROCEDURE SetHLPenState(fromHL, toHL: HLState);
  1635.  
  1636.     VAR
  1637.         pPat:                ^pattern;
  1638.         mode:                INTEGER;
  1639.  
  1640.     BEGIN
  1641.     mode := patXOR;                                     { every transition except hlOn <-> hlDim
  1642.                                                          uses patXOR }
  1643.  
  1644.     IF fromHL = toHL THEN
  1645.         pPat := @white
  1646.  
  1647.     ELSE IF fromHL + toHL = hlOffOn THEN
  1648.         pPat := @black
  1649.  
  1650.     ELSE
  1651.         pPat := @gray;                                    { ??? make this pattern a parameter ??? }
  1652.  
  1653.     IF fromHL + toHL = hlDimOn THEN
  1654.         mode := NOTpatXOR;
  1655.  
  1656.     PenMode(mode);
  1657.     PenPat(pPat^);
  1658.     END;
  1659.  
  1660. {--------------------------------------------------------------------------------------------------}
  1661. {$Push}
  1662. {$MC68020-}                                             { Need to be able to alert user if this
  1663.                                                          isn't a 68020 machine }
  1664. {$S MAGlobalsRes}                                        { Don't require a segment load for this }
  1665.  
  1666. PROCEDURE StdAlert(alertID: INTEGER);
  1667.  
  1668.     VAR
  1669.         reply:                INTEGER;
  1670.  
  1671.     BEGIN
  1672.     reply := MacAppAlert(alertID, NIL);
  1673.     END;
  1674. {$Pop}
  1675.  
  1676. {--------------------------------------------------------------------------------------------------}
  1677. {$S MAGlobalsRes}
  1678.  
  1679. FUNCTION SubstituteInTitle(VAR title: Str255;
  1680.                            newStuff: Str255;
  1681.                            preDocname, constTitle: INTEGER): BOOLEAN;
  1682.  
  1683.     BEGIN
  1684.     IF preDocname > 0 THEN
  1685.         BEGIN
  1686.         IF constTitle = 0 THEN
  1687.             title := newStuff
  1688.         ELSE
  1689.             BEGIN
  1690.             Delete(title, preDocname, LENGTH(title) - constTitle);
  1691.             Insert(newStuff, title, preDocname);
  1692.             END;
  1693.         SubstituteInTitle := TRUE;
  1694.         END
  1695.     ELSE
  1696.         SubstituteInTitle := FALSE;
  1697.     END;
  1698.  
  1699. {--------------------------------------------------------------------------------------------------}
  1700. {$IFC qDebug}
  1701. {$S MADebug}
  1702. {$Push} {$IFC qTrace} {$D+} {$ENDC}
  1703.  
  1704. PROCEDURE UseTempRgn(byWhom: Str255);
  1705.  { Call this when you are about to use gTempRgn and qDebug is true. Used
  1706.   with DoneWithTempRgn will prevent you from trying to use gTempRgn
  1707.   from two places at the same time. }
  1708.  
  1709.     BEGIN
  1710.     IF gBusyTempRgn THEN
  1711.         BEGIN
  1712.         WriteLn('"', byWhom, '" is trying to lock gTempRgn,');
  1713.         WriteLn('but it is already locked by "', gUsedBy, '"');
  1714.         ProgramBreak('Error in UseTempRgn');
  1715.         END
  1716.     ELSE
  1717.         BEGIN
  1718.         gBusyTempRgn := TRUE;
  1719.         gUsedBy := byWhom;
  1720.         END;
  1721.     END;
  1722. {$Pop}
  1723. {$ENDC qDebug}
  1724.  
  1725. {--------------------------------------------------------------------------------------------------}
  1726. {$S MAGlobalsRes}
  1727.  
  1728. PROCEDURE VisibleRect(VAR r: Rect);
  1729.  
  1730.     BEGIN
  1731.     IF NOT gDrawingPictScrap THEN
  1732.         BEGIN
  1733.         {$IFC qDebug}
  1734.         UseTempRgn('VisibleRect');
  1735.         {$ENDC}
  1736.         RectRgn(gTempRgn, r);
  1737.         
  1738.         { Some print drivers don't set the visRgn correctly.
  1739.         ??? Shouldn't this really be accounted for in printhandler code }
  1740.         IF NOT gPrinting THEN
  1741.             SectRgn(gTempRgn, thePort^.visRgn, gTempRgn);
  1742.         SectRgn(gTempRgn, thePort^.clipRgn, gTempRgn);
  1743.         r := gTempRgn^^.rgnBBox;
  1744.         {$IFC qDebug}
  1745.         DoneWithTempRgn;
  1746.         {$ENDC}
  1747.         END;
  1748.     END;
  1749.  
  1750. {--------------------------------------------------------------------------------------------------}
  1751. {$IFC qDebug}
  1752. {$S MADebug}
  1753.  
  1754. PROCEDURE WriteFocus;
  1755.  
  1756.     BEGIN
  1757.     WrLblVPt('  gLongOffset', gLongOffset);
  1758.     WriteLn;
  1759.     WrLblRect('     portRect', thePort^.portRect);
  1760.     WriteLn;
  1761.     WrLblRect('       visRgn', thePort^.visRgn^^.rgnBBox);
  1762.     WriteLn;
  1763.     WrLblRect('      clipRgn', thePort^.clipRgn^^.rgnBBox);
  1764.     WriteLn;
  1765.     END;
  1766. {$ENDC}
  1767.